C**PRESCN, CROCT, CROCX, UPMK, ONEUP, NUMS, LETS, ISGN, I2A, A2I
C** UPLIST. LETNUM. UPCNT, OUTX, ICHAR, TYPARY

	SUBROUTINE PRESCN
	COMMON NONO(29),JB(6),JP(1),J2,J3,J4,J5,JN,J,JJ 
	1 /MKX/KSLA,ISEMI,LESS,IGT,LBRK,IRBRK,NNO(3),MINUS
	1/DPY/ST(2190),ICRS(5),IOCT(5),NTS(600),IRH(400),IM(200),
	1 IB(200),ISL(200)  /ALF/I(73) /MKS/MKS(14)
	1 /JCHAR/IXX,ISEMX,IBLA,IG  /IDEV/IDEV
	1 /SCX/ICOM,MINU,IDOT,IEQ,LPRN,IRPRN,IPLUS,ISTAR,ICOLON
	COMMON/A2Z/LAA,LBB,LCC,LDD,LEE,LFF,LGG,LHH,LII,LJJ,LKK,LEL,
	1 LMM,LNN,LOH,LPP,LQQ,LRR,LSS,LTT,LUU,LVV,LWW,LXX,LYY,LZZ
CC	EQUIVALENCE (IOO,MKS(14)),(IR,MKS(13)),(IP,MKS(11)),(IA,MKS(2))
	EQUIVALENCE (J1,JP(1))
	IF(IDEV.EQ.5)GO TO 401
	CALL TYPSTR('***** READING FILE *****')
	CALL TYPCRLF
401	CALL OFILE(23,'MODE2')
400	DO 402 K=1,6
	JB(K)=0
402	JP(K)=0
	JN=0
	N=0

	DO 300 K=1,200
	IM(K)=0
300	ISL(K)=0
 
100	IF(N.NE.ISEMI)GO TO 500
	CALL TYPSTR('NOTES: ')
	CALL OUTIT(NTS,J1)
	CALL TYPSTR('RHYTHM: ')
	CALL OUTIT(IRH,J2)
	CALL TYPSTR('MARKS: ')
	CALL OUTIT(IM,J3)
	CALL TYPSTR('BEAMS: ')
	CALL OUTX(IB,J4)
	CALL TYPSTR('SLURS: ')
	CALL OUTX(ISL,J5)
C NOW START ANOTHER STAFF.
	GO TO 400

500	CALL READ(LND)
	IF(LND)RETURN
CCC	IF(I(1).EQ.'I')GO TO 50
C 'I' IS FOR 'INSERT' FEATURE
	J=0
201	JX=0
200	J=J+1
	IF(J.GT.LND)GO TO 100
	N=I(J)
	IF(N.EQ.IBLA)GO TO 200
	JJ=J
C JJ= PTR TO START OF ITEM
	GO TO(1,2,3,7,8,9,10)LETNUM(N)
C FINDS LETTER, NUM., / OR ;, < OR >, [ OR ], ( , ) 
 
1	JC=I(J+1)
 	IF(N.GT.LGG)GO TO 20
C JUMP IF NOT SCALE LETTER
	IF(N.EQ.LBB.AND.JC.EQ.LAA)GO TO 21
C JUMP IF BA (=BASS CLEF)
	IF(N.EQ.LAA.AND.JC.EQ.LEL)GO TO 21
C JUMP IF AL (=ALTO CLEF)
C*********↓↓↓↓↓↓↓↓↓↓↓↓*********************
	IF(N.NE.LCC)GO TO 22
	IF(JC.EQ.IPLUS.OR.JC.EQ.MINUS.OR.JC.EQ.LXX)GO TO 80
C JUMP FOR CRESC. (C+), DECRESC. (C-), OR END OF ONE OF THEM (CX)
C*********↑↑↑↑↑↑↑↑↑↑↑↑*********************
22	JX=1
122	N=ICHAR(J)
	IF(NUMS(N))GO TO 122
	IF(LETS(N))GO TO 122
	IF(N.EQ.ICOLON)GO TO 122
	IF(N.EQ.MINUS)GO TO 122
	IF(N.EQ.IPLUS)GO TO 122
CC	IF(N.EQ.IBLA)GO TO 23
CC	IF(N.EQ.KSLA)GO TO 23
CC	IF(N.NE.ISEMI)GO TO 22
23	J=J-1
C NOW WE HAVE A NOTE
	CALL UPLIST(NTS,J1)
	GO TO 200

20	IF(N.NE.LRR)GO TO 21
	JX=0
	IF(I(J+1).EQ.LEE)GO TO 301
C JUMP FOR 'REP' CODE 
	GO TO 122
21	IF(N.EQ.LPP)GO TO 22
	IF(N.NE.LOH)GO TO 121
C P=PROX., O=ORDIN.  BOTH ARE FOLLOWED BY NOTES.  O+ = OTTAVA
	IF(JC.EQ.IPLUS)GO TO 85
	IF(JC.EQ.LXX)GO TO 86
	GO TO 22
121	N=ICHAR(J)
	IF(N.NE.KSLA.AND.N.NE.ISEMI)GO TO 121
C NOW WE'VE FOUND /TR/  /SU/  K2F/  ETC.
	CALL UPLIST(NTS,J1)
	GO TO 201
 
2 	N=ICHAR(J)
12	IF(NUMS(N))GO TO 2
25	J=J-1
CCC	IF(I(J).EQ.'0')I(J)=LGG
28	CALL UPLIST(IRH,J2)
	GO TO 200
3	CALL ONEUP(NTS,J1,N)
	CALL ONEUP(IRH,J2,N)
C PUT IN THE / OR ;
	IF(JX.NE.0)JN=JN+1 
	GO TO 200

C SLURS
9	ISL(J5+1)=ISGN(J)
	J5=J5+2
	M=-1
	GO TO 24

10	N=J5
C SLUR END POINT
110	IF(ISL(N).EQ.0)GO TO 109
	N=N-2
C ADD AN ERROR TRAP HERE
	GO TO 110
109	ISL(N)=JN+1
	GO TO 200
  
C BEAMS
8	IF(I(J+2).EQ.IRBRK)GO TO 4
	J4=J4+1
	IB(J4)=ISGN(J)
	M=0
24	IF(NUMS(I(J+1)).EQ.0)GO TO 200
C JUMP OUT IF NO NUMB. FOLLOWS [ OR (
	N=ICHAR(J)
	CALL A2I(J,N)
C GO CHANGE ASCII TO INTEGER
	L=N+JN
	IF(M)GO TO 34
	CALL ONEUP(IB,J4,L)
	GO TO 200
34	IF(N.LT.96)GO TO 35
C NEXT FOR SLURS BEFORE AND AFTER LIMITS
C 99=SLUR ABOVE NOTE→PAST END; 98=SLUR AT NOTE LEVEL→PAST END
C 97=SLUR ABOVE NOTE←FROM BEFORE END; 96=SLUR AT NOTE LEVEL←FROM BEFORE END
	L=N
	IF(N.EQ.99)L=99
	IF(N.EQ.98)L=JN+2
35	ISL(J5)=L
C SLUR END POINT
	GO TO 200

4	J=J+2
	IF(NUMS(I(J+1)))GO TO 42
	JC=ISEMI
	JD=0
	N=1
14	J4=J4+3
	IB(J4-2)=I(J-N)
	IB(J4-1)=LBB
	IB(J4)=JC
	IF(JD.EQ.0)GO TO 200
	J4=J4+1
	IB(J4)=JD
	GO TO 200
42	JC=ICHAR(J)
	JD=ISEMI
	N=2
	GO TO 14
 
7	N=1
74	CALL UPMK(JN+N,0,IBLA)
70	N=ICHAR(J)
	IF(N.EQ.IBLA)GO TO 70
	IF(NUMS(N).EQ.0)GO TO 73
	CALL A2I(J,N)
C CHANGES ASCII TO INTEGER
	GO TO 74
C NOW SHOULD BE LETTERS
73	L=J+1
C*********↓↓↓↓↓↓↓↓↓↓↓↓*********************
77	N=I(L)
	IF(N.NE.IDOT)GO TO 71
	IM(J3)=N
	IM(J3+1)=I(L+1)
C ONLY ONE DIGIT TO RIGHT OF DECIMAL IS ALLOWED.
	IM(J3+2)=IBLA
	J3=J3+2
	I(L)=IBLA
	L=L+1
	I(L)=IBLA
71	IF(N.EQ.IGT.OR.N.EQ.IBLA)GO TO 75
78	L=L+1
	IF(L.LE.LND)GO TO 77
75	DO 72 N=J,L-1
	J3=J3+1
72	IM(J3)=I(N)
	J=L
	J3=J3+1
	IM(J3)=KSLA
	GO TO 76
79	J=J+1
76	IF(I(J).EQ.IGT)GO TO 200
	IF(I(J).EQ.IBLA)GO TO 79
C*********↑↑↑↑↑↑↑↑↑↑↑↑*********************
	J=J-1
	GO TO 7
 
C*********↓↓↓↓↓↓↓↓↓↓↓↓*********************
80	IF(JC.EQ.IXX)GO TO 81
C SETSUP 1ST PART OF CRESC-DECRESC
	CALL CROCT(ICRS,N,JC)
84	J=J+1
	GO TO 200
85	CALL CROCT(IOCT,N,IBLA)
	GO TO 84
81	CALL CROCX(ICRS)
	GO TO 84
86	CALL CROCX(IOCT)
	GO TO 84
C*********↑↑↑↑↑↑↑↑↑↑↑↑*********************
	
301	J=J+2
CODE FOR 'REP N M/'
	JC=-1
30	N=ICHAR(J)
	IF(N.EQ.IBLA)GO TO 30
	CALL A2I(J,N)
	IF(JC.GE.0)GO TO 31
	JC=N
C JC IS NOW 1ST NUM AFTER REP.
	GO TO 30
31	JD=J1
C N IS NOW 2ND NUMBER.
	IRP=0
	ITM=0
	JZ=JC
	IF(JZ.GT.100)JZ=JZ-100
C >100 IS FOR 'REP' WITHOUT REPEATING ACCIS.
33	MM=JD
32	JD=JD-1
	IF(NTS(JD).NE.KSLA)GO TO 32
C BACK UP TO PREV. SLASH
	IF(MM-JD.GT.1)GO TO 39
	IRP=IRP+1
	GO TO 33
C NOW LOOK FORWARD TO 1ST CHAR. AFTER SLASH
39	MM=NTS(JD+1)
	IF(MM.EQ.LRR)GO TO 36
	IF(MM.EQ.LOH)GO TO 37
	IF(MM.EQ.LPP)GO TO 37
	IF(MM.GT.LGG)GO TO 33
37	ITM=ITM+1
36	JZ=JZ-1
38	IF(JZ.GT.0)GO TO 33
	JN=JN+ITM*(N-1)
	CALL UPLIST(NTS,J1)
	GO TO 28
 
	END
	
	SUBROUTINE CROCT(K,N,JC)
	DIMENSION K(1)
	COMMON NONO(35),J1,J2,J3,J4,J5,JN,J,JJ /ALF/I(1)
	1 /SCX/ICOM,MINU,IDOT
C SETSUP 1ST PART OF CRESC-DECRESC, OTTAVA
	K(1)=JN+1
 	K(2)=JC
	K(3)=I(J+2)
	K(4)=I(J+3)
C K4 SHOULD BE / ; BLANK OR NUM.
	IF(K(3).EQ.IDOT)J=J+2
	END

	SUBROUTINE CROCX(K)
	COMMON NONO(35),J1,J2,J3,J4,J5,JN,J,JJ /ALF/I(1)
	1/DPY/ST(2190),ICRS(5),IOCT(5),NTS(600),IRH(400),IM(200)
	1 /MKX/KSLA  /JCHAR/IXX,ISEMX,IBLA
	DIMENSION K(1)
81	CALL UPMK(K,K(3),IBLA)
	IM(J3+1)=I(J)
	IM(J3+2)=K(2)
	J3=J3+3
 	IM(J3)=IBLA
	CALL UPMK(JN+1,I(J+2),KSLA)
	END

	SUBROUTINE UPMK(N,L,LL)
	DIMENSION L(1)
	COMMON NO(35),J1,J2,J3,J4,J5,JN,J,JJ
	1/DPY/ST(2190),ICRS(5),IOCT(5),NTS(600),IRH(400),IM(200)
	1 /MKX/KSLA,ISEMI,LESS,IGT,LBRK,IRBRK /NUM/N0 
	1 /SCX/ICOM,MINU,IDOT
	J3=J3+3
	CALL I2A(N,MM,M,N)
	IM(J3-2)=M
	IF(M.EQ.N0)J3=J3-1
	IM(J3-1)=N
	IF(L(1).NE.IDOT)GO TO 1
	IM(J3)=IDOT
	J3=J3+2
	IM(J3-1)=L(2)
	IF(LL.EQ.KSLA)J=J+2
1	IM(J3)=LL
	END

	SUBROUTINE ONEUP(L,J,N)
	DIMENSION L(1)
	J=J+1
	L(J)=N
	END

	FUNCTION NUMS(N)
	COMMON /NUM/N0,NN(8),N9 /SCX/ICOM,MINU,IDOT
C FINDS ASCII NUMBER  (NUMS=-1)
	NUMS=0
	IF(N.GE.N0.AND.N.LE.N9)NUMS=-1
	IF(N.EQ.IDOT)NUMS=-1
C DOT IS CONSIDERED PART OF A NUMBER
	END

	FUNCTION LETS(N)
	COMMON /A2Z/LAA,A(24),LZZ
C FINDS LETTER  (LETS=-1)
	LETS=0
	IF(N.GE.LAA.AND.N.LE.LZZ)LETS=-1
	END

	FUNCTION ISGN(J)
	COMMON NO(35),J1,J2,J3,J4,J5,JN 
	1 /ALF/I(1) /MKX/NNO(9),MINUS
	1 /SCX/ICOM,MINU,IDOT,IEQ,LPRN,IRPRN,IPLUS,ISTAR
	ISGN=JN+1
	N=I(J+1)
	IF(N.EQ.IPLUS)GO TO 1
	IF(N.NE.MINUS)RETURN
	ISGN=-ISGN
	GO TO 2
1	ISGN=ISGN+100
C FOR SLUR AND BEAM STEM REVERSAL
2	J=J+1
	END
 
	SUBROUTINE I2A(JN,MM,M,N)
	COMMON/NUM/NUM(0/9)
	K=JN
	N=K/100
	MM=NUM(N)
	K=K-N*100
	N=K/10
	M=NUM(N)
	N=NUM(K-N*10)
C CHANGES 2-DIGIT NUMBERS TO FROM INTEGER TO ASCII
	END
 
	SUBROUTINE A2I(J,N)
	COMMON /ALF/I(1) /NUM/NUM(0/9)
	L=N
	N=0
3	DO 1 K=0,9
1	IF(L.EQ.NUM(K))GO TO 2
2	N=N*10+K
	L=I(J+1)
	IF(NUMS(L).EQ.0)RETURN
	J=J+1
	GO TO 3
	END
 
	SUBROUTINE UPLIST(N,K)
	DIMENSION N(1)
	COMMON NONO(35),J1,J2,J3,J4,J5,JN,J,JJ
	COMMON /ALF/I(1)
	DO 1 L=JJ,J
	K=K+1
1	N(K)=I(L)
	END
 
	FUNCTION LETNUM(N)
	COMMON NONO(35),J1,J2,J3,J4,J5,JN,J,JJ /MKX/MKX(1)
	COMMON /ALF/I(1) /NUM/NUM(0/9) /JCHAR/IXX,ISEMX,IBLA
1	IF(N.NE.IBLA)GO TO 2
	N=ICHAR(J)
	GO TO 1
2	IF(NUMS(N).EQ.0)GO TO 3
4	LETNUM=2
	RETURN
3	IF(LETS(N).EQ.0)GO TO 40
CATCHES LETTERS AND MINUS SIGN (FOR INVIS. CLEFS)
7	LETNUM=1
	RETURN
40	DO 5 K=1,11
5	IF(N.EQ.MKX(K))GO TO (6,6,9,9,10,10,11,11,4,7,8)K
CCC	CALL ERR(J)
6	LETNUM=3
C /  ;
	RETURN
8	LETNUM=8
C *   
	RETURN
9	LETNUM=4
C < >
	RETURN
10	LETNUM=5
C [ ]]
	RETURN
11	LETNUM=K-1
C ( )
	END
 
	SUBROUTINE UPCNT
	COMMON NONO(35),J1,J2,J3,J4,J5,JN,J,JJ
	COMMON /ALF/I(1) /NUM/NUM(0/9) /JCHAR/IXX,ISEMX,IBLA
C GETS LAST NOTE NUM.
	K=J
	JR=0
1	K=K-1
	N=I(K)
	IF(NUMS(N))GO TO 1
	CALL A2I(K,N)
	IF(JR.NE.0)GO TO 4
	JN=JN+N-1
	RETURN
2	JR=N
3	K=K-1
	IF(I(K).EQ.IBLA)GO TO 3
	GO TO 1
4	JN=JN+JR*N-N-1
	END
 
	SUBROUTINE OUTX(IX,J)
	DIMENSION IX(1)
	COMMON NONO(35),J1,J2,J3,J4,J5,K,L,MM/NUM/N0,NO(8),N9
	1/DPY/ST(2200),NTS(600),IRH(400),IM(200),IB(200),ISL(200) 
	1 /MKX/KSLA,ISEMI /JCHAR/IXX,ISEMX,IBLA /A2Z/LAA,LBB
	1 /SCX/ICOM,MINUS
	K=1
	IF(J.LE.1)GO TO 4
	IF(IX(2).NE.LBB)GO TO 3
C NEXT FOR AUTO-BEAMS  (E.G. 2B;  3B1; ETC.)
	CALL OUTIT(IX,J)
	RETURN

3	DO 6 L=1,J,2
	MM=IX(L)
	IF(MM.GE.100)GO TO 5
	IF(MM.GE.0)GO TO 6
	IX(L)=-MM
CHANGE -M,N TO M,-N
	IX(L+1)=IX(L+1)+200
	GO TO 6
5	IX(L)=MM-100
CHANGES M+100,N TO M,N+100
	IX(L+1)=IX(L+1)+100
6	CONTINUE

	JJ=IBLA
	NN=1
	DO 1 L=1,J
	LL=IX(L)
	CALL I2A(LL,MM,M,N)
	IF(LL.LT.96)GO TO 7
	IF(LL.GE.99)GO TO 7
	IF(LL.EQ.98)GO TO 8
	MY=NTS(K-3)
	MZ=NTS(K-2)
	NTS(K-4)=MINUS
	IF(LL.EQ.96)GO TO 10
	N=N9 
	GO TO 11
10	M=N0 
	N=MZ
11	NTS(K-3)=M
	IF(M.EQ.N0)K=K-1
	NTS(K-2)=N
	M=MY
	N=MZ
	GO TO 7
C THESE ARE FOR SLURS BEFORE AND AFTER STAFF LIMIT
8	N=N0 
	M=N0 
7	NTS(K)=MM
	IF(MM.EQ.N0)K=K-1
	NTS(K+1)=M
	IF(M.EQ.N0.AND.MM.EQ.N0)K=K-1
	NTS(K+2)=N
	NTS(K+3)=JJ
	JJ=KSLA
	IF(NN)JJ=IBLA
	NN=-NN
1	K=K+4
	K=K-1
4	NTS(K)=ISEMI
	DO 2 L=K+1,K+79
2	NTS(L)=IBLA
	CALL OUTIT(NTS,K)
	END
 
	FUNCTION ICHAR(J)
	COMMON /ALF/I(1)
	J=J+1
	ICHAR=I(J)
	END

	SUBROUTINE TYPARY(I,K)
	DIMENSION I(1)
	DO 8 L=1,K
8	CALL TYPCHR(I(L),1)
	CALL TYPCRLF
	END

	SUBROUTINE READ(K)
	COMMON NONO(29),JB(6),JP(6) /IDEV/IDEV /JCHAR/IXX,ISEMX,IBLA
	COMMON /ALF/I(73) /MKX/KSLA,ISEMI/NUM/NUM(10),JRD
	1 /A2Z/AA,BB,LCC,NO(11),LOH
C ALL DATA IN WORDS DATA NUM/'0','1','2','3','4','5','6','7','8','9'/,JRD/0/
	EQUIVALENCE (N9,NUM(10))
14	IF(JRD)GO TO 2
	IF(IDEV.NE.5)GO TO 1
15	CALL TYPSTR('TYPE @@ ')
	CALL TYPCRLF
C IDEV=0 AFTER ';' IS SEEN.
1	READ(IDEV,10,END=2)I
	IF(I(1).NE.LCC)GO TO 4
	IF(I(2).NE.LOH)GO TO 4
C FOR X!Z&#% ET DIRECTORY
5	READ(1,10)I
	IF(I(3).NE.ISEMI)GO TO 5
	GO TO 1
4	IF(I(1).NE.N9)GO TO 11
	IF(I(2).NE.N9)GO TO 11
C TYPE '99' TO BACKUP  - ONE LINE ONLY EACH TIME.
	DO 12 L=1,6
C GET BACK LAST POINTERS
12	JP(L)=JB(L)
	IF(IDEV.EQ.5)CALL TYPCHR('RE',2)
	GO TO 15
11	DO 16 K=73,1,-1
	N=I(K)
16	IF(N.EQ.KSLA.OR.N.EQ.ISEMI)GO TO 17
	GO TO 15
17	DO 9 L=1,K
C WIPE OUT COMMAS
9	IF(I(L).EQ.',')I(L)=IBLA
	DO 13 L=1,5
C SAVE POINTERS FOR POSSIBLE BACKUP
13	JB(L)=JP(L)

CC	DO 3 K=73,1,-1
CC	N=I(K)
	IF(N.EQ.ISEMI)JRD=-1
CC	IF(N.NE.KSLA.AND.N.NE.ISEMI)GO TO 3
	IF(IDEV.EQ.5)WRITE(21,10)(I(L),L=1,K)
C SAVE TYPED INPUT ON 'FOR21.DAT'
	RETURN
CC3	CONTINUE
CC	GO TO 1
C UNTERMINATED LINE (NO / OR ; )IS IGNORED. (FOR COMMENTS)
CC	IF(I(1).NE.'@')GO TO 1
C START LINE WITH '@' FOR LITERAL REPRODUCTION.
CCC	DO 6 K=73,1,-1
CCC6	IF(I(K).NE.' ')GO TO 7
CCC7	WRITE(23,10)(I(L),L=2,K)
CC	TYPE 10,(I(L),L=1,K)
CCC	CALL TYPARY(I,K)
CCC	GO TO 1
C IGNORES BLANK LINES OR UNTERMINATED LINES.
10	FORMAT(73A1)
2	END FILE 23
	IF(IDEV.EQ.5)END FILE 21
	JRD=0
	K=-1
	END
	
	SUBROUTINE OUTIT(I,K)
	COMMON /MKX/KSLA,ISEMI /IDEV/IDEV
	DIMENSION I(1)
	IF(K.EQ.0)K=1
	I(K)=';'
	M=1
1	N=M+60
	DO 2 L=N,M,-1
	J=I(L)
2	IF(J.EQ.KSLA.OR.J.EQ.ISEMI)GO TO 3
3	IF(L.GT.K)L=K
	WRITE(23,10)(I(J),J=M,L)
CC	TYPE 11,(I(J),J=M,L)
	CALL TYPARY(I(M),L-M+1)
	IF(L.EQ.K)RETURN
	M=L+1
	GO TO 1
10	FORMAT(70A1)
CC11	FORMAT(1X70A1)
	END